home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / GRAB.WPL < prev    next >
Text File  |  1994-01-14  |  24KB  |  709 lines
  1. /**/ 
  2. v="$VER: GRAB Wplrx  Roof Remote File Xfer Utility        Williamson 54.35"
  3.  
  4. /* The number of requests permitted per call. Note some magic names */
  5. /* may return more than one file. Each magic name is counted as one */
  6. maxfiles=3
  7.  
  8. /* maximum number of files and sessions for a verified user         */
  9. maxpsessions=10
  10.  
  11. /* your list of files recd in last week */
  12. newfiles="Mail:filelists/newfiles.lst"
  13.  
  14. /* help files for new users */
  15. newinfo="Info:Grab.hlp"
  16.  
  17. /* TAGNAME of your SYSOP Feedback message base */
  18. sysopbase=GetClip('SYSOPBASE')
  19.  
  20. /* Your name */
  21. sysop=GetClip('SYSOP')
  22.  
  23. /* Verified user Data */
  24. ucfg="CFG:Guser.dat"
  25.  
  26. /* Non-Secure Inbound directory for users */
  27. indir=addslash(dequote(getclip('INDIR')))||'USERS/'
  28.  
  29. /* If RFS is used instead of XfreqSh, maximum config and request    */
  30. /* accounting will take precedence over maxfiles setting            */
  31. rfs=1
  32.  
  33. /* if NOT using RFS */
  34. freqcmd="run Xfreqsh >LOG:Freq.log CFG:FREQ.cfg"
  35.  
  36. options RESULTS
  37. options failat 99
  38. signal on syntax
  39. signal on halt
  40. signal on ioerr
  41. signal on break_c
  42. signal on break_d
  43. pragma("W","NULL")
  44. rpath=addslash(dequote(GetClip('REXXDIR')))
  45.  
  46. if ~show('L', "rexxsupport.library") then
  47.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  48.          say "Couldn't access support.library !"
  49.         exit 20
  50.     end
  51.  
  52. log=show('P','ROOFLOG')
  53. mailer=GetCLip('SHELTER')
  54. l_mailer=lower(mailer)
  55. wplport=l_mailer
  56. sv='v'||right(v,5)
  57. script="GRAB"
  58. cr   ='\r\n'  /* WPL */
  59. nl   ='0a'X   /* REXX */
  60. bs   ='08'x
  61. quote='"'
  62. tmsg="T:GRAB-"pragma('ID')
  63.  
  64. parse arg baud port username
  65. btarea=center("GRAB "sv,21)
  66. btitle=center("A WPL Application by Robert Williamson",41)
  67. call send(cr||cr||center('GRAB File Requester 'sv' on $(host.sitename) Line 'port,80)||cr)   
  68. call send(" ╒═════════════════════════╤═════════════════════╤═════════════════════════╕ "||cr)
  69. call send(" │░░░░░▒▒▒▒▒▓▓▓▓▓█████▓▓▓▓▓│"btarea"│▓▓▓▓▓█████▓▓▓▓▓▒▒▒▒▒░░░░░│ "||cr)
  70. call send(" ├───────────────┬─────────┴─────────────────────┴─────────┬───────────────┤ "||cr)
  71. call send(" │░░░░░▒▒▒▒▒▓▓▓▓▓│"btitle"│▓▓▓▓▓▒▒▒▒▒░░░░░│ "||cr)
  72. call send(" ╘═══════════════╧═════════════════════════════════════════╧═══════════════╛ "||cr||cr)
  73. call send(" MAKE SURE your terminal program has the following protocol settings:"||cr)
  74. call send(" Zmodem CRC32 with AutoDownLoad ON and ADL Challenge ON."||cr)
  75. call send(" Do not waste time guessing filenames, requesting files that are not"||cr) 
  76. call send(" in the FileList or which are larger than the allowable free bytes!"||cr)
  77. call send(" These are the requirements to GRAB files"||cr)
  78.  
  79. if username="" then fname=wpl_prompt(60,cr||' Please enter your name: ')
  80.     else fname=strip(username)
  81.  
  82. if fname="" | words(fname)<2 | index(fname,"'") ~=0  | index(fname,"`") ~=0 then do
  83.     call send(cr||'Sorry, your first name and last name (sans apostrophes) is required to GRAB files'||cr)
  84.     'Set USER FALSE'
  85.     call cleanup()
  86.     exit 0
  87. end
  88.  
  89. xname='$(p.login) 'fname time()
  90. 'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) 'xname'"'
  91. tdomain=translate(fname,"_"," ") ; address="0:0/0.0"
  92. verified=ReadVar("VUSER"port)=="TRUE"
  93. call PutLog('Login:'fname tdomain"#"address,10,10)
  94.  
  95. notgrabreq=1
  96. if ~rfs then reqfile="0.0.0.0.REQ"
  97. else do
  98.     reqfile=tdomain".GRAB"
  99.     if exists(indir||reqfile) then do
  100.         call send(cr||' Found your request list'||cr)
  101.         notgrabreq=0
  102.     end
  103.  
  104.     if notgrabreq then do
  105.         call send(' So 'fname', if you do not have the $(host.sitename) filelist, quit GRAB'||cr) 
  106.         call send(' and select FILES from the MAGIC menu, in order to receive it via Zmodem.'||cr||cr)
  107.  
  108.         AcctFile="LOG:RFSacct/h/"||tdomain||".0.0.0.0"
  109.         if ~exists(AcctFile) then do
  110.             call Send(' We have No account for you yet 'fname||cr)
  111.             call Send(' Accounts are only created when you have made requests.'||cr)
  112.             call display_text(newinfo)
  113.         end;else do
  114.             call Send(' You can automate your GRAB sessions by uploading 'tdomain'.GRAB,'||cr)
  115.             call Send(' containing the list of files you want, with the UL command.'||cr)
  116.         end
  117.         
  118.     end 
  119.  
  120.     if ~verified then do
  121.         if ~verify() then do
  122.             call PutLog(fname' declined verification',10,10)
  123.             verified=0
  124.         end;else do
  125.             maxfiles=maxpsessions
  126.             verified=1
  127.         end
  128.     end
  129.  
  130.     if notgrabreq then call show_status()
  131.  
  132.     'Set remote.address' tdomain"#"address
  133.     'SetA remote $(remote.address)'
  134.     'Set remote.network FIDO'
  135.     'BeginSession $(remote.address)'
  136.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB session with $(remote.address)"'
  137. end
  138. reqname=indir||reqfile
  139.  
  140. if notgrabreq then do
  141.     resp=wpl_prompt(30,' View new files received in the last week? (y,N) ')
  142.     if upper(resp)="Y" then call display_text(newfiles)
  143. end
  144.  
  145. rereq:
  146.     if notgrabreq then call getrequests
  147.     if lostcarrier('request entry') then exit
  148.     if ~notgrabreq then signal getfiles
  149. getstate:
  150.     resp=upper(wpl_prompt(30,' [D]ownload, [R]e-enter, [A]bort ? '))
  151.     if resp="R" then signal rereq
  152.     else if resp="A" then do
  153.         call PutLog(fname 'aborted',10,10)
  154.         call send(cr||cr||' -> Bye!'||cr||cr)
  155.         call cleanup
  156.         exit
  157.     end
  158.     else if resp~="D" then signal getstate
  159.  
  160. getfiles:
  161.     if word(statef(reqname),2) ~= 0 then do
  162.         call send(cr||' Please WAIT, now searching for the files you have requested'||cr)
  163.         call send(' You have a few seconds to MAKE SURE Zmodem is your default'||cr)
  164.         call send(' protocol and that both AutoDownLoad and ADL Challenge are ON.'||cr)
  165.         call send(' If you do not have these settings, the transfer will fail.'||cr)
  166.         if rfs then do
  167.             host_address=GetClip('DOMAIN')"#"GetClip('HOST.ADDRESS.'||GetClip('DOMAIN'))
  168.             address "REXX" rpath'RFS.rexx' wplport port baud host_address reqname verified tdomain'#'address fname
  169.         end;else do
  170.             cmd=freqcmd reqfile reqname tdomain'#'address port
  171.             address COMMAND cmd
  172.         end
  173.         call send(cr||' Ready! '||cr)
  174.         if lostcarrier('during search') then exit
  175.         Address "LOGPROC" "PutLine 'l_mailer'wplstat"||port protpos "ZMODEM"
  176.         call xfer()
  177.         dl=1
  178.     end;else do
  179.         call send(cr||' No files requested'||cr)
  180.         dl=0
  181.     end
  182.  
  183.     if dl then resp=wpl_prompt(60,cr||' Well 'fname', do you want to thank the sysop for these free downloads? y/N ')
  184.         else resp=wpl_prompt(60,cr||' Well 'fname', do you want to leave the sysop a message? y/N ')
  185.     if upper(resp)="Y" then call feedback
  186.  
  187.     call send(cr||cr||' -> Bye!'||cr||cr)
  188.  
  189.     if ~dl then call PutLog('No requests from' fname,10,10)
  190.     call cleanup()
  191. exit 0
  192.  
  193. getrequests:
  194.     call send(' Enter filenames (maximum 'maxfiles', NO WILDCARDS!)'||cr)
  195.     call send(' or a blank line to start transfer.'||cr)
  196.  
  197.     if ~Open('reqfile',reqname,'A') then do
  198.         if ~Open('reqfile',reqname,'W') then do
  199.             call PutLog("Error opening" reqname,10,10)
  200.             call cleanup
  201.             Exit 10
  202.         end
  203.     end
  204.     do n=1 to maxfiles
  205.         wantfile=wpl_prompt(60,cr||' FILE 'n': ')
  206.         if wantfile="" then leave
  207.             else call WriteLN('reqfile',strip(wantfile))
  208.         call PutLog(fname 'requesting:'strip(wantfile),10,10)
  209.     end
  210.     call close('reqfile')
  211. return
  212.  
  213. xfer:
  214.     t='GRAB $(protocol) Sending to 'fname
  215.     'Set req TRUE protocol ZMODEM inbound' indir
  216.     if ~rfs then do
  217.         'Set remote.address' tdomain"#"address
  218.         'BeginSession $(remote.address)'
  219.     end
  220.     'Set titadr' '"'t'"'
  221.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB sending files to $(remote.address)"'
  222.     'RexxMsg NY "LOGPROC" "PutLine 'l_mailer'wplstat$(line) $(p.protocol) $(protocol)"'
  223.     'SetMailerFlags' '"DN,PN"'
  224.     'XprSetup' 'xprzedzap.library' 'TN,ON,B8,F0,E30,AN,DN,KN,SN,RN,NN,M1024'
  225.     'SetUpDate "CON:0/$($(line).w_offset)/640/130/$(titadr)/AUTO/SCREEN$(pscreen)"'
  226.     'XprSend ""'
  227.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) $(protocol) Send:$(RC)"'
  228.     'XprClose'
  229.     'SetUpDate NULL'
  230.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) $(protocol) RC:$(RC)"'
  231.     'EndSession all'
  232. return
  233.  
  234. display_text:
  235.     textfile=arg(1)
  236.     if ~open('tf',textfile,"R") then do
  237.         call Send(cr||'Sorry, unable to find 'textfile||cr)
  238.         call PutLog("Cannot open "textfile,10,10)
  239.         return 0
  240.     end
  241.     call PutLog('Typing 'textfile' for 'fname,10,10)
  242.     call send(cr)
  243.     lines=0
  244.     do while ~eof('tf')
  245.         if lostcarrier('during text display') then exit
  246.         call send(readln('tf')||cr)
  247.         lines=lines+1
  248.         if lines=24 then do
  249.             lines=0
  250.             resp=wpl_prompt(60,cr||'More(Y,n): ')
  251.             if upper(resp)="N" then do
  252.                 call close('tf')
  253.                 call send(cr)
  254.                 return 0
  255.             end;else do
  256.                 call send(copies(bs,12))
  257.             end
  258.         end
  259.     end
  260.     call close('tf')
  261.     call send(cr)
  262. return 0
  263.  
  264. show_status:
  265.     if ~open('rcfg',"RAM:RFS.CFG",'r') then
  266.         if ~open('rcfg',"CFG:RFS.CFG",'r') then return 0
  267.     call seek('rcfg',-512,'E')
  268.     do while ~eof('rcfg')
  269.         z=readln('rcfg')
  270.         if upper(left(word(z,1),3))="MAX" then interpret z
  271.     end
  272.     call close('rcfg')
  273.  
  274.     call send(cr)
  275.     AcctFile="LOG:RFSacct/h/"||tdomain||".0.0.0.0"
  276.     if ~exists(AcctFile) then do
  277.         call Send(' Opening new account for 'fname||cr)
  278.         call Send(' Account will be deleted if no requests made.'||cr)
  279.         FirstDate=date()
  280.         LastDate =date()
  281.         NumReqs  =0
  282.         ReqFiles =0
  283.         ReqBytes =0
  284.         LastBytes=0
  285.         UserCalls=1
  286.         limits="RESET"
  287.         if verified then do
  288.             availbytes=(baud*100)
  289.             availsessions=maxpsessions
  290.         end;else do
  291.             availbytes=MaxHBytes
  292.             availsessions=MaxCalls
  293.         end
  294.     end;else do
  295.         call open('Acct',AcctFile,'R')
  296.         FirstDate=readln('Acct')
  297.         LastDate =readln('Acct')
  298.         NumReqs  =readln('Acct')
  299.         ReqFiles =readln('Acct')
  300.         ReqBytes =readln('Acct')
  301.         LastBytes=readln('Acct')
  302.         UserCalls=readln('Acct')
  303.         call close('Acct')
  304.         if Date()=LastDate then do
  305.             limits="ACTIVE"
  306.             if verified then do
  307.                 availbytes=(baud*100)-LastBytes
  308.                 availsessions=maxpsessions-UserCalls
  309.             end;else do
  310.                 availbytes=MaxDaily-LastBytes
  311.                 availsessions=MaxCalls-UserCalls
  312.             end
  313.         end;else do
  314.             limits="RESET"
  315.             if verified then do
  316.                 availbytes=(baud*100)
  317.                 availsessions=maxpsessions
  318.             end;else do
  319.                 availbytes=MaxHBytes
  320.                 availsessions=MaxCalls
  321.             end
  322.         end
  323.     end
  324.     call send(copies(" ",12)||' ╒════════════════════════════════════════════════╕'||cr)
  325.     call send(copies(" ",12)||' │  Account                :'right_justify(fname||" │",23)||cr)
  326.     call send(copies(" ",12)||' │  First Call             :'right_justify(Firstdate||" │",23)||cr)
  327.     call send(copies(" ",12)||' │  Last Call              :'right_justify(LastDate||" │",23)||cr)
  328.     call send(copies(" ",12)||' │  Number of Requests     :'right_justify(NumReqs||" │",23)||cr)
  329.     call send(copies(" ",12)||' │  Files Transfered       :'right_justify(ReqFiles||" │",23)||cr)
  330.     call send(copies(" ",12)||' │  Total Bytes Sent       :'right_justify(ReqBytes||" │",23)||cr)
  331.     call send(copies(" ",12)||' │  Bytes Sent Last Call   :'right_justify(LastBytes||" │",23)||cr)
  332.     call send(copies(" ",12)||' │  Number of Sessions     :'right_justify(Usercalls||" │",23)||cr)
  333.     call send(copies(" ",12)||' │  Files available        :'right_justify(maxfiles||" │",23)||cr)
  334.     call send(copies(" ",12)||' │  Bytes available        :'right_justify(availbytes||" │",23)||cr)
  335.     call send(copies(" ",12)||' │  Remaining Sessions     :'right_justify(availsessions||" │",23)||cr)
  336.     call send(copies(" ",12)||' │  Daily limits           :'right_justify(limits||" │",23)||cr)
  337.     call send(copies(" ",12)||" ╘════════════════════════════════════════════════╛"||cr||cr)
  338. return
  339.  
  340. /* feedback to sysop */
  341. feedback:
  342.     call PutLog('GRAB feedback from 'fname,10,10)
  343.     call send(cr||' To:                  'sysop)
  344.     call send(cr||' From:                'fname)
  345.     resp=wpl_prompt(60,cr||' Subject (Return aborts): ')
  346.     if resp="" then do
  347.         call send(cr||' Message aborted'||cr)
  348.         return 0
  349.     end
  350.     else subject=strip(resp)
  351.  
  352.     call send(cr||' Enter your message one line at a time.'||cr)
  353.     call send(cr||' Hit Return to select Save or continue.'||cr)
  354.  
  355.     call open('smsg',tmsg,"W")
  356.     call writech('smsg'," GRAB Feedback to Sysop "resp" from "fname" Posted:"date()" at "time()||nl)
  357.     editing=1
  358.     line=1
  359.     c=0
  360.     do while editing
  361.         do while resp ~= ""
  362.             if lostcarrier('during feedback') then leave
  363.             resp=wpl_prompt(200,"-->"line": ")
  364.             if resp ~= "" then do
  365.                 chars=writech('smsg',resp||nl)
  366.                 c=c+chars
  367.                 line=line+1
  368.             end
  369.         end /* hit a blank line */
  370.  
  371.         if lostcarrier('during feedback') then do
  372.             call writech('smsg',fname 'dropped carrier'||nl)
  373.             call save_msg
  374.             exit
  375.         end
  376.         resp=wpl_prompt(120,cr||' You entered 'line-1' lines and 'chars' characters (total:'c'), [S]ave/[c]ontinue?'||cr)
  377.         if upper(resp)="S" then editing=0
  378.     end  /* finished editing */
  379.     call save_msg
  380.     call send(cr||' Message saved, thanks' fname||cr)
  381. return 0
  382.  
  383. save_msg:
  384.     call writech('smsg',nl)
  385.     call close('smsg')
  386.     call PutLog('Saving message from 'fname' in 'sysopbase,10,10)
  387.     call send(cr||' Saving......')
  388.     if exists("RPDIR:Smsg") then do
  389.         cmd=sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  390.         call PutLog('Executing:' cmd,10,10)
  391.         address COMMAND "run >NIL: Smsg" cmd
  392.     end;else do
  393.         cmd=rpath'Smsg.rexx' sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  394.         call PutLog('Executing:' cmd,10,10)
  395.         Address "AREXX" cmd
  396.     end
  397.     address
  398. return
  399.  
  400.  
  401. lostcarrier:
  402.     'CheckCarrier'
  403.     if RC=0 then return 0
  404.     call PutLog(fname 'dropped carrier during 'arg(1),10,10)
  405.     call cleanup
  406. return 1
  407.  
  408. send:
  409.     'Print' quote||arg(1)||quote
  410.     'Send' quote||arg(1)||quote
  411. return
  412.  
  413. wpl_prompt:
  414.     'Print' quote||arg(2)||quote
  415.     'Send' quote||arg(2)||quote
  416. getstring:
  417.     'GetInbound E0 'arg(1)
  418.     'String $(event)'
  419.     if upper(RESULT)='CARRIER' then do
  420.         'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) Lost Carrier"'
  421.         call PutLog(fname' dropped carrier',10,10)
  422.         call cleanup
  423.         exit
  424.     end
  425.     else if upper(RESULT)='LOGIN' then do
  426.         'String $(namebuf)'
  427.         x=(RESULT)
  428.     end
  429.     else x=""
  430. return x
  431.  
  432. /* get filename */
  433. get_fn:
  434. if LastPos('/', arg(1)) ~= 0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
  435.     else if LastPos(':', arg(1)) ~= 0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
  436.         else return arg(1)
  437.  
  438. /* align text to right of field  adding spaces or trucating on left to fit   */
  439. right_justify:
  440. if length(arg(1)) > arg(2) then return (right(arg(1),arg(2)))
  441.     else return (copies(" ",arg(2)-length(arg(1))) || arg(1))
  442.  
  443. PutLog:  procedure expose log script
  444. if ~log then do
  445.      'RexxMsg RN "LOGPROC" "Putlog 'l_mailer'wpl $<time> $(line) 'script':' arg(1)
  446. end;else do
  447.     if arg(2) > GetClip('LOGLEVEL') then return 0
  448.     address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  449.     address
  450. end
  451. return 0
  452.  
  453. addslash:
  454. curr=arg(1)
  455. select
  456.     when right(curr, 1)=":" then nop
  457.     when right(curr, 1)="/" then nop
  458.         otherwise curr=curr"/"
  459. end
  460. return curr
  461.  
  462. /* a useful procedure by Walt Sullivan    */
  463. dequote:
  464. parse arg thing
  465. parse var thing '"' unq_thing '"'
  466. if unq_thing ~= "" then return unq_thing
  467. return thing
  468.  
  469. lower:
  470. return(bitor(arg(1),'20'x))
  471.  
  472. cleanup:
  473. call delete(reqname)
  474. call close('tf')
  475. return 0
  476. break_c:
  477. break_d:
  478.     PutLog('User abort',10,10)
  479.     call cleanup
  480.     exit 10
  481. novalue: 
  482.         call template_oops "Novalue" sigl
  483. syntax:
  484.         call template_oops "Syntax(RC=" || RC || ")" sigl RC
  485. failure:
  486.         call template_oops "Failure(RC=" || RC || ")" sigl
  487. ioerr:
  488.         call template_oops "IOErr" sigl
  489. halt:
  490.         call template_oops "Halt" sigl
  491.  
  492. template_oops:
  493. parse arg what badline code
  494. if code ~= "" then PutLog('ERR: Line 'badline what errortext(code),10,10)
  495.     else PutLog('ERR: Line' badline what,10,10)
  496. PutLog('ERR: Line 'badline':'strip(sourceline(badline)),10,10)
  497. call cleanup
  498. exit(40)
  499. /**/
  500.  
  501. verify:
  502.     retries=3
  503.     call Send(cr||" If you are a LOCAL caller and wish to be able to DL more than the"||cr) 
  504.     call Send(" prescribed limits, please enter your phone number. The system will call"||cr)
  505.     call Send(" you back in a few moments. Enable autoanswer with ATS0=0 or type ATA"||cr)
  506.     call Send(" when you see the RING. You must enter your password when asked."||cr) 
  507.  
  508.     call Send(" If you are a LONG-DISTANCE caller, and have made an arrangement with the"||cr)
  509.     call Send(" Sysop, enter X instead of Y or N, and enter your password when asked."||cr) 
  510.     resp=upper(wpl_prompt(120," Do you wish to be verified? (Y/n) "))
  511.     if resp="X" then isdistant=1
  512.     else isdistant=0
  513.     if resp="N" then return 0
  514.  
  515. if isdistant then do
  516.     phonenumber=wpl_prompt(120," Enter access number: ")
  517.     if ~find_user(phonenumber) then do
  518.         call Send(" Invalid access number, sorry"||cr)
  519.         return 0
  520.     end
  521.     if ~getpassword(password) then do
  522.         call send(cr||cr||'Too bad'||cr)
  523.         call PutLog(fname ' bad LD password',10,10)
  524.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.password) BAD"'
  525.         call cleanup
  526.         exit
  527.     end;else do
  528.         status=fname' verified'
  529.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status' $(p.password) OK"'
  530.         call PutLog(status,10,10)
  531.         return 1
  532.     end
  533. end;else do
  534.     phonenumber=""
  535.     do i=1 to retries
  536.         resp=wpl_prompt(120," Enter your local phone number: ")
  537.         resp=compress(resp,'- ')
  538.         if ~datatype(resp,'NUMERIC') then do
  539.             call Send(' Wierd number, 'retries-i' trys left'||cr)
  540.             iterate
  541.         end
  542.         if length(resp)~=7 | substr(resp,2,2)="11" | left(resp,1)="0" then do
  543.             call Send(' Illegal, Invalid or Long Distance number, 'retries-i' trys left'||cr)
  544.             iterate
  545.         end;else do
  546.             phonenumber=resp
  547.             leave
  548.         end
  549.     end
  550.     if phonenumber="" then do
  551.         call send(' You blew your chance!'||cr)
  552.         call send(' You may still use GRAB, but you will limited in number of files'||cr)
  553.         call send(' and total bytes you can download'||cr)
  554.         return 0
  555.     end
  556.  
  557.     if ~find_user(phonenumber) then do
  558.         call send(' Opening new user account'||cr)
  559.         if ~set_password() then do
  560.             call send(' You blew your chance!'||cr)
  561.             return 0
  562.         end
  563.     end
  564.  
  565.     resp=upper(wpl_prompt(30," The system will now hangup and call you back at "phonenumber", OK? (Y/n) "))
  566.     if resp="N" then do
  567.         call send(' You blew your chance'||cr)
  568.         return 0
  569.     end
  570.  
  571.     pnum="ATDT"phonenumber"|"
  572.     do i=1 to retries
  573.         status='CBV Dialing 'fname', try:'i
  574.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status '$(p.number)' phonenumber '$(p.response)"'
  575.         call PutLog(status,10,10)
  576.         call delay(60)
  577.         if mdmcmd(30,'$(hangupstring)','OK') then do
  578.             call delay(60)
  579.             if mdmcmd(5,'$(initstring)','OK') then do
  580.                 call delay(60)
  581.                 if mdmcmd(120,pnum,'CONNECT') then do
  582.                     'ModemClear'
  583.                     status='Reconnected to 'fname' on try 'i', getting password'
  584.                     'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status '$(p.response) CONNECT"'
  585.                     call PutLog(status,10,10)
  586.                     if ~getpassword(password) then do
  587.                         call send(cr||cr||'Too bad'||cr)
  588.                         call PutLog(fname ' bad password',10,10)
  589.                         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.password) BAD"'
  590.                         call cleanup
  591.                         exit
  592.                     end;else do
  593.                         status=fname' verified'
  594.                         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status' $(p.password) OK"'
  595.                         call PutLog(status,10,10)
  596.                         return 1
  597.                     end
  598.                 end;else do
  599.                     'Print "No response to dial\n"'
  600.                     iterate
  601.                 end
  602.             end;else do
  603.                 'Print "Cannot reinit\n"'
  604.                 iterate
  605.             end
  606.         end;else do
  607.             'Print "Cannot hangup\n"'
  608.             iterate
  609.         end
  610.     end
  611.     call PutLog('Unable to contact 'fname' @ 'phonenumber,10,10)
  612.     if ~open('um',"LOG:RFSacct/h/"||tdomain||".0.0.0.0.m",'A') then do
  613.         if ~open('um',"LOG:RFSacct/h/"||tdomain||".0.0.0.0.m",'W') then do
  614.             call putlog('Unable to inform user',10,10)
  615.             call cleanup
  616.             exit 0
  617.         end
  618.     end
  619. end
  620.     call writeln('um',"                   Call Back Verifier Report")
  621.     call writeln('um'," After three attempts, we were unable to connect with you at" phonenumber".")
  622.     call writeln('um'," Either the number given was incorrect or is Long Distance from this exchange.")
  623.     call close('um')
  624.     call PutLog('Posted failure to connect message to user',10,10)
  625.     call cleanup
  626. exit 0
  627.  
  628. mdmcmd:
  629.     'Clear event lastresponse'
  630.     'ModemClear'
  631.     'SmartSend 'arg(2)
  632.     call delay(100)
  633.     'GetResponse' arg(1)
  634.     'String $(event)'
  635. return(upper(RESULT)==arg(3))
  636.  
  637.  
  638. getpassword:
  639.     'ModemClear'
  640.     call delay(60)
  641.     call send(cr||cr||' CallBack Verifier 'sv||cr)
  642.     do i=1 to retries
  643.         if lostcarrier('password request') then exit
  644.         resp=upper(wpl_prompt(120," Password: "))
  645.         if upper(arg(1))~=resp then call send(' Wrong, 'retries-i' trys left'||cr)
  646.         else do
  647.             call send(' Ok!'||cr)
  648.             address COMMAND 'SetEnv VUSER'port' TRUE'
  649.             return 1
  650.         end
  651.     end
  652. return 0
  653.  
  654. set_password:
  655.     do i=1 to retries
  656.         password=""
  657.         if lostcarrier('new password request') then exit
  658.         resp=upper(wpl_prompt(120," Select an 8 character Password: "))
  659.         if length(resp) ~=8 then call send(' Invalid format, 'retries-i' trys left'||cr)
  660.         else do
  661.             password=strip(resp)
  662.             call delay(20)
  663.             resp=upper(wpl_prompt(120,' Ok, enter it again:'))
  664.             if resp~=password then do
  665.                 call send(' Does not match!'||cr)
  666.                 iterate
  667.             end;else do
  668.                 if ~open('u',ucfg,'A') then do
  669.                     if ~open('u',ucfg,'W') then do
  670.                         call PutLog('Unable to open 'ucfg,10,10)
  671.                         call send(cr||'System error'||cr)
  672.                         exit
  673.                     end
  674.                 end
  675.                 call writeln('u',phonenumber password fname)
  676.                 call close('u')
  677.                 address COMMAND "Sort" ucfg ucfg
  678.                 call PutLog(fname' @ 'phonenumber' selected a password',10,10)
  679.                 call send(cr||'Password accepted'||cr)
  680.                 return 1
  681.             end
  682.         end
  683.     end
  684. return 0
  685.  
  686.  
  687. find_user:
  688.     call delete("T:upw")
  689.     address COMMAND "Fsearch >t:upw" ucfg arg(1)
  690.     call open('p',"T:upw",'R')
  691.     udat=readln('p')
  692.     call close('p')
  693.     if left(udat,2)="!@" then return 0
  694.     parse VAR udat unum upw uname
  695.     if upper(uname)=upper(fname) then do
  696.         password=upw
  697.         return 1
  698.     end;else do
  699.         call send(cr||cr||' ***** ILLEGAL LOGIN *****'||cr||cr)
  700.         call PutLog(fname' impersonating 'uname,10,10)
  701.         exit
  702.     end
  703. return 0
  704.  
  705. ReadVar: procedure
  706. if ~open('v','ENV:'arg(1),'r') then return ""
  707. x=readln('v') ; call close('v') ; drop v
  708. return x
  709.